home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tclsrc / pushd.tcl < prev    next >
Encoding:
Text File  |  1992-11-07  |  1.4 KB  |  54 lines
  1. #
  2. # pushd.tcl --
  3. #
  4. # C-shell style directory stack procs.
  5. #
  6. #------------------------------------------------------------------------------
  7. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: pushd.tcl,v 2.0 1992/10/16 04:52:06 markd Rel $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. #@package: TclX-directory_stack pushd popd dirs
  21.  
  22. global TCLENV(dirPushList)
  23.  
  24. set TCLENV(dirPushList) ""
  25.  
  26. proc pushd {args} {
  27.     global TCLENV
  28.  
  29.     if {[llength $args] > 1} {
  30.         error "bad # args: pushd [dir_to_cd_to]"
  31.     }
  32.     set TCLENV(dirPushList) [linsert $TCLENV(dirPushList) 0 [pwd]]
  33.  
  34.     if {[llength $args] != 0} {
  35.         cd [glob $args]
  36.     }
  37. }
  38.  
  39. proc popd {} {
  40.     global TCLENV
  41.  
  42.     if [llength $TCLENV(dirPushList)] {
  43.         cd [lvarpop TCLENV(dirPushList)]
  44.         pwd
  45.     } else {
  46.         error "directory stack empty"
  47.     }
  48. }
  49.  
  50. proc dirs {} { 
  51.     global TCLENV
  52.     echo [pwd] $TCLENV(dirPushList)
  53. }
  54.